HPAVC/HPAVC CD-ROM.iso/pc/PHRO.ZIP/TUNNEL.PAS

Pascal/Delphi Source File | 1995-07-21 | 11.1 KB | 453 lines

{   Gouruad Tunnel Source File                 }
{   PHRO!                                      }
{   Phred/OTM                                  }
{   [e-mail]                      }
{   DO NOT DISTRIBUTE THIS SOURCE FILE         }
Unit Tunnel;
{$G+}

Interface

Procedure DoTunnel;

Implementation

Uses Polygons;

Type
  RGB = Record
    r, g, b : Byte;
  End;
  Palette = Array[0..255] of RGB;
  SCoord = Record
    x, y : Integer;
  End;
  LCoord = Record
    x, y, z : Integer;
    t : Integer;
  End;
  PathRec = Array[0..14] of LCoord;
  TCircle = Array[0..15] of SCoord;
  tType = Array[0..65534] of Byte;
  pType = ^tType;

Var
  Pal : Palette;
  Circle : Array[0..14] of TCircle;
  TwistCount : Integer;
  Path : PathRec;
  HorizontalSway : Array[0..255] of Integer;
  VerticalSway : Array[0..255] of Integer;
  vPage : pType;

Procedure CalcCircle;

Var
  Count : Integer;
  Count2 : Integer;

Begin
  For Count2 := 0 to 14 do
    For Count := 0 to 11 do
      Begin
        Circle[Count2][Count].x := Round(50*Cos((Count2*2*Pi/(15*5.2))+(Count*2*Pi/12)));
        Circle[Count2][Count].y := Round(50*Sin((Count2*2*Pi/(15*5.2))+(Count*2*Pi/12)));
      End;
End;

Procedure DrawPath(ViewerZ : Integer);

Var
  sx, sy : Integer;
  CircleCount, Count : Integer;
  Polygon : Array[0..3] of SCoord;
  Div1, Div2 : Integer;
  Color1, Color2 : Integer;
  Base : Byte;

Begin
  For CircleCount := 14 downto 1 do
    Begin
      Div1 := Path[CircleCount].z-ViewerZ;
      Div2 := Path[CircleCount-1].z-ViewerZ;
      Color1 := Div1 Shr 2;
      Color2 := Div2 Shr 2;

      For Count := 0 to 10 do
        Begin
          Asm
            Mov  bl,0
            Mov  ax,Count
            Test ax,1
            Jne @SkipBase
            Mov  bl,64
           @SkipBase:
            Mov  Base,bl

            Mov  bx,TwistCount
            Shl  bx,6            { Get to vertex information }
            Mov  dx,Count
            Shl  dx,2
            Add  bx,dx

            Mov  di,CircleCount
            Shl  di,3

            { Polygon[0] }

            Mov  cx,Div1

            Mov  ax,Word Ptr [Circle+bx]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di]
            Mov  Word Ptr [Polygon],ax
            Mov  ax,Word Ptr [Circle+bx+2]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di+2]
            Mov  Word Ptr [Polygon+2],ax

            { Do Polygon[1] }

            Mov  ax,Word Ptr [Circle+bx+4]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di]
            Mov  Word Ptr [Polygon+4],ax
            Mov  ax,Word Ptr [Circle+bx+6]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di+2]
            Mov  Word Ptr [Polygon+6],ax

            { Polygon[2] }

            Sub  bx,64
            Sub  di,8
            Mov  cx,Div2

            Mov  ax,Word Ptr [Circle+bx+4]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di]
            Mov  Word Ptr [Polygon+8],ax
            Mov  ax,Word Ptr [Circle+bx+6]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di+2]
            Mov  Word Ptr [Polygon+10],ax

            Mov  ax,Word Ptr [Circle+bx]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di]
            Mov  Word Ptr [Polygon+12],ax
            Mov  ax,Word Ptr [Circle+bx+2]
            Cwd
            Shl  ax,8
            IDiv cx
            Add  ax,Word Ptr [Path+di+2]
            Mov  Word Ptr [Polygon+14],ax
          End;
          GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
                      Polygon[1].x, Polygon[1].y,
                      Polygon[2].x, Polygon[2].y,
                      Color1 + Base, Color1 + Base, Color2 + Base, Seg(VPage^));
          GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
                      Polygon[2].x, Polygon[2].y,
                      Polygon[3].x, Polygon[3].y,
                      Color1 + Base, Color2 + Base, Color2 + Base, Seg(VPage^));
        End;
        Polygon[0].x := (Circle[TwistCount][11].x) Shl 8 Div Div1 + Path[CircleCount].x;
        Polygon[0].y := (Circle[TwistCount][11].y) Shl 8 Div Div1 + Path[CircleCount].y;
        Polygon[1].x := (Circle[TwistCount][0].x) Shl 8 Div Div1 + Path[CircleCount].x;
        Polygon[1].y := (Circle[TwistCount][0].y) Shl 8 Div Div1 + Path[CircleCount].y;
        Polygon[2].x := (Circle[TWistCount-1][0].x) Shl 8 Div Div2 + Path[CircleCount-1].x;
        Polygon[2].y := (Circle[TwistCount-1][0].y) Shl 8 Div Div2 + Path[CircleCount-1].y;
        Polygon[3].x := (Circle[TwistCount-1][11].x) Shl 8 Div Div2 + Path[CircleCount-1].x;
        Polygon[3].y := (Circle[TwistCount-1][11].y) Shl 8 Div Div2 + Path[CircleCount-1].y;

        GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
                    Polygon[1].x, Polygon[1].y,
                    Polygon[2].x, Polygon[2].y,
                    Color1, Color1, Color2, Seg(VPage^));
        GouraudClipPolygon(Polygon[0].x, Polygon[0].y,
                    Polygon[2].x, Polygon[2].y,
                    Polygon[3].x, Polygon[3].y,
                    Color1, Color2, Color2, Seg(VPage^));

        TwistCount := TwistCount - 1;
        If TwistCount <= 1
          Then TwistCount := 14;
      End;
End;

Procedure MakePath;

Var
  Count : Integer;

Begin
  For Count := 0 to 255 do
    Begin
      HorizontalSway[Count] := Round(50*Sin(Count*2*Pi/256)) + 160;
      VerticalSway[Count] := Round(45*Sin(Count*2*Pi/256)) + 100;
    End;
  For Count := 0 to 14 do
    Begin
      Path[Count].z := (Count+1) * 20;
      Path[Count].x := 160;
      Path[Count].y := 100;
    End;
End;

Procedure ClearPage(P : Pointer); Assembler;

Asm
  Les  di,P
  Mov  cx,16000
  db 66h; Xor  ax,ax
  db 66h; Rep Stosw
End;

Procedure CopyPage(P : Pointer); Assembler;

Asm
  Push  ds
  Mov   ax,$A000
  Mov   es,ax
  Xor   di,di
  Lds   si,P
  db 66h; Mov   cx,16000; dw 0;
  db 66h; Rep Movsw
  Pop   ds
End;

Procedure DoAnim;

Var
  Count : Integer;
  Angle1 : Integer;
  Angle2 : Integer;
  FrameCount : Integer;
  Pal1 : Palette;

Begin
  ClearPage(VPage);
  TwistCount := 14;
  Angle1 := 0;
  Angle2 := 0;
  FillChar(Pal1, 768, 63);
  Pal[0].r := 0;
  Pal[0].g := 0;
  Pal[0].b := 0;
  For FrameCount := 0 to 63 do
    Begin
      For Count := 0 to 255 do
        Begin
          If Pal1[Count].r < Pal[Count].r
            Then Inc(Pal1[Count].r);
          If Pal1[Count].r > Pal[Count].r
            Then Dec(Pal1[Count].r);
          If Pal1[Count].g < Pal[Count].g
            Then Inc(Pal1[Count].g);
          If Pal1[Count].g > Pal[Count].g
            Then Dec(Pal1[Count].g);
          If Pal1[Count].b < Pal[Count].b
            Then Inc(Pal1[Count].b);
          If Pal1[Count].b > Pal[Count].b
            Then Dec(Pal1[Count].b);
        End;
      Asm
        Mov  dx,$3da
       @Looper:
        In   al,dx
        And  al,8
        Jz  @Looper
      End;
      Asm
        Mov  dx,$3c8
        Xor  al,al
        Out  dx,al
        Inc  dx
        Mov  si,0
        Mov  cx,768

       @Looper:
        Mov  al,Byte Ptr [Pal1+si]
        Out  dx,al
        Inc  si
        Dec  cx
        Jnz @Looper
      End;
      For Count := 0 to 1 do
        Begin
          DrawPath(Count*10);
          CopyPage(VPage);
          ClearPage(VPage);
        End;
      Asm
        Mov  cx,14
        Mov  di,8
       @Looper:
        db 66h; Mov  ax,Word Ptr [Path+di]
        Sub  di,8
        db 66h; Mov  Word Ptr [Path+di],ax
        Add  di,16
        Dec  cx
        Jnz @Looper
      End;
      Path[14].x := HorizontalSway[Angle1];
      Path[14].y := VerticalSway[Angle2];
      Angle1 := (Angle1 + 0) And 255;
      Angle2 := (Angle2 + 0) And 255;
    End;

  For FrameCount := 0 to 128 do
    Begin

      For Count := 0 to 1 do
        Begin
          DrawPath(Count*10);
          Asm
            Mov  dx,$3da
           @Looper:
            In   al,dx
            And  al,8
            Jz  @Looper
          End;
          CopyPage(VPage);
          ClearPage(VPage);
        End;
      Asm
        Mov  cx,14
        Mov  di,8
       @Looper:
        db 66h; Mov  ax,Word Ptr [Path+di]
        Sub  di,8
        db 66h; Mov  Word Ptr [Path+di],ax
        Add  di,16
        Dec  cx
        Jnz @Looper
      End;
      Path[14].x := HorizontalSway[Angle1];
      Path[14].y := VerticalSway[Angle2];
      Angle1 := (Angle1 + 10) And 255;
      Angle2 := (Angle2 + 5) And 255;
    End;
  For FrameCount := 0 to 63 do
    Begin
      For Count := 0 to 255 do
        Begin
          If Pal1[Count].r > 0
            Then Dec(Pal1[Count].r);
          If Pal1[Count].g > 0
            Then Dec(Pal1[Count].g);
          If Pal1[Count].b > 0
            Then Dec(Pal1[Count].b);
        End;

      For Count := 0 to 1 do
        Begin
          DrawPath(Count*10);
          Asm
            Mov  dx,$3da
           @Looper:
            In   al,dx
            And  al,8
            Jz  @Looper
          End;
          CopyPage(VPage);
          ClearPage(VPage);
        End;
      Asm
        Mov  dx,$3c8
        Xor  al,al
        Out  dx,al
        Inc  dx
        Mov  si,0
        Mov  cx,768

       @Looper:
        Mov  al,Byte Ptr [Pal1+si]
        Out  dx,al
        Inc  si
        Dec  cx
        Jnz @Looper
      End;

      Asm
        Mov  cx,14
        Mov  di,8
       @Looper:
        db 66h; Mov  ax,Word Ptr [Path+di]
        Sub  di,8
        db 66h; Mov  Word Ptr [Path+di],ax
        Add  di,16
        Dec  cx
        Jnz @Looper
      End;
      Path[14].x := HorizontalSway[Angle1];
      Path[14].y := VerticalSway[Angle2];
      Angle1 := (Angle1 + 10) And 255;
      Angle2 := (Angle2 + 5) And 255;
    End;
  For Count := 0 to 255 do
    Begin
      Port[$3c8] := Count;
      Port[$3c9] := 0;
      Port[$3c9] := 0;
      Port[$3c9] := 0;
    End;
  FillChar(Mem[$A000:0], 64000, 0);
End;

Procedure SetFadePalette(r1, g1, b1, r2, g2, b2, CStart, CEnd : Byte);

Var
  RStep, GStep, BStep : Longint;
  RVal, GVal, BVal : Longint;
  Count : Integer;

Begin
  RVal := Longint(R1) Shl 8;
  GVal := Longint(G1) Shl 8;
  BVal := Longint(B1) Shl 8;
  RStep := Longint(R2-R1+1) Shl 8 Div (CEnd-CStart+1);
  GStep := Longint(G2-G1+1) Shl 8 Div (CEnd-CStart+1);
  BStep := Longint(B2-B1+1) Shl 8 Div (CEnd-CStart+1);
  For Count := CStart to CEnd do
    Begin
      Pal[Count].r := RVal Div 256;
      Pal[Count].g := GVal Div 256;
      Pal[Count].b := BVal Div 256;
      RVal := RVal + RStep;
      GVal := GVal + gStep;
      BVal := BVal + bStep;
    End;
End;

Procedure DoTunnel;

Begin
  New(VPage);
  SetFadePalette(63, 63, 0, 0, 0, 0, 1, 75);
  SetFadePalette(63, 0, 0, 0, 0, 0, 76, 150);
  DoAnim;
  Dispose(VPage);
End;



Begin
  CalcCircle;
  MakePath;
End.